home *** CD-ROM | disk | FTP | other *** search
/ START Magazine / START VOL 4 NO 10.st / info_src.arc / INFOBASE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-02-01  |  14.1 KB  |  468 lines
  1. {$E+}
  2. Program InfoBaseST ;
  3. {
  4. *************************************************************************
  5. *                                                                       *
  6. *                            InfoBaseST                                 *
  7. *                            ----------                                 *
  8. *                        Atari ST Data Base                             *
  9. *                                                                       *
  10. *           (c) Copyright 1990 by Antic Publishing, Inc.                *
  11. *                                                                       *
  12. *                     Written by:                                       *
  13. *                           James W. Maki                               *
  14. *                           3701 S. Orchard Street, #I7                 *
  15. *                           Tacoma, WA   98466-7912                     *
  16. *                           (206) 5656-4167                             *
  17. *                                                                       *
  18. *                                                                       *
  19. *   Started       : August 8, 1988                                      *
  20. *   Last Revision : January 29, 1990                                    *
  21. *                                                                       *
  22. *************************************************************************
  23. }
  24.       {$I A:GEMSUBS.PAS }
  25.       {$I A:AUXSUBS.PAS }
  26.  
  27.  Const
  28.       {$I B:MOD_CONS.PAS }
  29.  
  30.  Type
  31.       {$I B:MOD_TYPE.PAS }
  32.  
  33.  Var
  34.       {$I B:MOD_VAR.PAS }
  35.  
  36.   LABEL 1 ;
  37.  
  38. {   ********************* External *************************************   }     
  39.  
  40.   procedure CopyRight ;
  41.      External ;
  42.  
  43.   procedure Keyboard_Input( Key_Input : short_integer ) ;
  44.      External ;
  45.  
  46.   procedure MB_Input( X, Y : short_integer ) ;
  47.      External ;
  48.  
  49.   procedure SetUpMenu ;
  50.      External ;
  51.  
  52.   procedure MenuOption ;
  53.      External ;
  54.  
  55.   procedure Menu_Select( msg : Message_Buffer) ;
  56.      External ;
  57.  
  58.   procedure DrawRecord(CurRec : DataPtr) ;
  59.      External ;
  60.  
  61.   procedure Do_Redraw( Msg : Message_Buffer ) ; 
  62.      External ;
  63.  
  64.   procedure NewCursor(ScrMode : short_integer) ;
  65.      External ;
  66.  
  67.   procedure ModifyWName ;
  68.      External ;
  69.  
  70.   procedure UpdateInfoLine ;
  71.      External ;
  72.  
  73.   procedure Select_Close ;
  74.      External ;
  75.  
  76.   procedure IncrementRec(Var  CurRec : DataPtr ; Value : short_integer ;
  77.                               DrawFlag : boolean ) ;
  78.      External ;
  79.  
  80.   procedure ClrHome ;
  81.      External ;
  82.  
  83.   procedure Set_VSlideSize ;
  84.      External ;
  85.  
  86.   procedure DrawDZ_In ;
  87.      External ;
  88. {   ********************************************************************   }     
  89.  procedure Wind_VSlide( WindNo, SlidePos : short_integer ) ;
  90.  
  91.    var
  92.        L_I,
  93.        L_Rec,
  94.        L_Offset,
  95.        L_SlidePos : long_integer ;
  96.        i,
  97.        Value,
  98.        MoveRec,
  99.        Dummy,
  100.        StartRec   : short_integer ;
  101.  
  102.     begin
  103.       L_I := 1 ;
  104.       L_SlidePos := L_I * SlidePos;
  105.  
  106.       case Mode of
  107.           2 : begin
  108.                 L_Rec := L_I * (TotalRec[ScrNum] - 1) ;
  109.                 L_Offset := (L_Rec * L_SlidePos) DIV 1000 ;
  110.                 MoveRec := (RecNo[DataNum] - 1) - Int(L_Offset) ;
  111.                 if MoveRec < 0 then
  112.                    for i := 1 to ABS(MoveRec) do
  113.                        begin
  114.                          D_CurrentRec[DataNum] := 
  115.                            D_CurrentRec[DataNum]^.Next ;
  116.                          RecNo[DataNum] := RecNo[DataNum] + 1 ;
  117.                       end 
  118.                 else
  119.                    if MoveRec > 0 then
  120.                       for i := 1 to MoveRec do
  121.                           begin
  122.                             D_CurrentRec[DataNum] := 
  123.                               D_CurrentRec[DataNum]^.Prev ;
  124.                             RecNo[DataNum] := RecNo[DataNum] - 1 ;
  125.                           end ;
  126.                 ClrHome ;
  127.                 DrawRecord(D_CurrentRec[DataNum]) ;
  128.               end ;
  129.           3 : begin
  130.                 L_Rec := L_I * F_TotalRec[ScrNum] ;
  131.                 L_Offset := (L_Rec * L_SlidePos) DIV 1000 ;
  132.                 StartRec := Int(L_Offset) ;
  133.                 D_CurrentRec[DataNum] := D_FirstRec[DataNum] ;
  134.                 RecNo[DataNum] := 1 ;
  135.                 F_RecNo[DataNum] := 1 ;
  136.                 F_CurRec := F_FirstRec ;
  137.                 if StartRec >= F_TotalRec[DataNum] then
  138.                    StartRec := F_TotalRec[DataNum] - 1 ;
  139.                  
  140.                 if StartRec > 0 then
  141.                    for i := 1 to StartRec do
  142.                        begin
  143.                          F_CurRec := F_CurRec^.Next ;
  144.                          F_RecNo[DataNum] := F_RecNo[DataNum] + 1 ;
  145.                        end ;
  146.                 MoveRec := F_CurRec^.Match ;
  147.                 
  148.                 if MoveRec > 1 then
  149.                    for i := 2 to MoveRec do
  150.                        begin
  151.                          D_CurrentRec[DataNum] := D_CurrentRec[DataNum]^.Next ;
  152.                          RecNo[DataNum] := RecNo[DataNum] + 1 ;
  153.                        end ;
  154.                 ClrHome ;
  155.                 DrawRecord(D_CurrentRec[DataNum]) ;
  156.               end ;
  157.           5 : if TotScrRec > 10 then
  158.                  begin
  159.                    L_Rec := L_I * (TotScrRec - 10) ;
  160.                    PL_Offset := Int((L_Rec * L_SlidePos) DIV 1000) ;
  161.                    DrawDZ_In ;
  162.                  end ;
  163.       end ;
  164.  
  165.       UpdateInfoLine ;
  166.       if Mode = 5 then
  167.          NewCursor(Report)
  168.       else
  169.          NewCursor(ScrNum) ;
  170.     end ;
  171.  
  172.  procedure Wind_VArrow(Var CurRec : DataPtr ; msg : short_integer) ;
  173.  
  174.    var
  175.       Count,
  176.       SaveOffset : short_integer ;
  177.       L_I,
  178.       L_SlidePos : long_integer ;
  179.  
  180.     begin
  181.       case Mode of
  182.          1,2, 
  183.           3  : case msg of
  184.                  0,2 : IncrementRec(CurRec, -1, true) ;
  185.                  1,3 : IncrementRec(CurRec, 1, true) ;
  186.                end;
  187.           5  : begin
  188.                  SaveOffset := PL_Offset ;
  189.                   case msg of
  190.                      0 : Count := -10 ;
  191.                      1 : Count :=  10 ;
  192.                      2 : Count :=  -1 ;
  193.                      3 : Count :=   1 ;
  194.                   end ;
  195.                   
  196.                  PL_Offset := PL_Offset + Count ;
  197.                  if PL_Offset < 0 then 
  198.                     PL_Offset := 0
  199.                  else
  200.                     if PL_Offset + 10 > TotScrRec then
  201.                        PL_Offset := TotScrRec - 9 ;
  202.                  if SaveOffset <> PL_Offset then      
  203.                     begin
  204.                       DrawDZ_In ;
  205.                       L_I := 1 ;
  206.                       if TotScrRec > 10 then
  207.                          L_SlidePos := (L_I * 1000 * PL_Offset) 
  208.                                         DIV (TotScrRec - 10)
  209.                       else
  210.                          L_SlidePos := 1 ;
  211.                       Wind_Set(WindNum, WF_VSlide, L_SlidePos, 0, 0, 0) ;
  212.                     end ;
  213.                end ;
  214.       end ;
  215.       if Mode = 5 then
  216.          NewCursor(Report)
  217.       else
  218.          NewCursor(ScrNum) ;
  219.     end;
  220.  
  221.   procedure Event_Loop ;
  222. {
  223.      Event_Loop is the "Traffic Manager" of InfoBaseST.  All input is 
  224.      processed through this routine.  GEM system messages are also
  225.      evaluated and acted upon.
  226. }
  227.     var
  228.        GemEvent  : short_integer ;
  229.        msg       : Message_Buffer ;
  230.        Key_Input,
  231.        B_State,
  232.        B_Count,
  233.        X_Mouse, 
  234.        Y_Mouse,
  235.        Key_State : short_integer ;
  236.  
  237.      begin
  238.        Work_Rect(WindNum, x, y, w, h);
  239.        Set_Clip(x, y, w, h);
  240.  
  241.        GemEvent := Get_Event(
  242.           E_Keyboard | E_Button | E_Timer | E_Message,
  243.           1, 1, 1, 1,
  244.           true, 0, 0, 0, 0,
  245.           true, 0, 0, 0, 0,
  246.           msg,
  247.           Key_Input,
  248.           B_State, B_Count,
  249.           X_Mouse, Y_Mouse,
  250.           Key_State);
  251.  
  252.        if (GemEvent & E_Message) <> 0 then
  253.          begin
  254.           Case msg[0] of
  255.              MN_Selected : Menu_Select(msg) ;
  256.              WM_Closed   : Select_Close ;
  257.              WM_Redraw   : if ShortDraw then
  258.                               ShortDraw := false
  259.                            else
  260.                               Do_Redraw( msg ) ;
  261.              WM_VSlid    : if D_CurrentRec[DataNum] <> nil then
  262.                               Wind_VSlide(msg[3],msg[4]) ;
  263.              WM_Arrowed  : if D_CurrentRec[DataNum] <> nil then
  264.                               case msg[4] of
  265.                                  0,1,
  266.                                  2,3 : Wind_VArrow(D_CurrentRec[DataNum], msg[4]) ;
  267.                               end ;
  268.           end ;
  269.           MenuOption ;
  270.           
  271.          end
  272.        else
  273.           if (GemEvent & E_Keyboard) <> 0 then
  274.              Keyboard_Input(Key_Input)
  275.           else
  276.              if ((GemEvent & E_Button) <> 0) AND
  277.                  (X_Mouse < w) then
  278.                 MB_Input(X_Mouse, Y_Mouse)
  279.              else
  280.                 if UpdateFlag then
  281.                    UpdateInfoLine ;
  282.      end; 
  283.  
  284.   procedure DrawNewWindow ;
  285. {
  286.      DrawNewWindow makes the necessary calls to display a GEM window on the
  287.      Screen.
  288. }
  289.      begin
  290.        WindName[1] := '' ;
  291.        WindNum := New_Window(
  292.             G_Name | G_Close | G_Info | G_UpArrow | G_DnArrow | G_VSlide, 
  293.             WindName[1],0,0,0,0) ;
  294.        WindInfo[WindNum] := chr($20) ;
  295.        Set_WInfo(WindNum, WindInfo[WindNum]) ;
  296.        Open_Window(WindNum,0,0,0,0) ;
  297.        ModifyWName ;
  298.      end ;
  299.  
  300.   procedure GetMemBlocks ;
  301. {
  302.      Determine amount of free memory available and the memory requirements
  303.      of the pointer variables used during the program.
  304. }
  305.      begin
  306.        MaxMem := MemAvail * 2 ;
  307.        DataRecSize := SizeOf(DataStore) ;
  308.        PtrRecSize := SizeOf(DataInfo) ;
  309.        ScrRecSize := SizeOf(ScrInfo) ;
  310.      end ;
  311.  
  312.      
  313.   procedure GetCurPath(Var C_PathStr : C_String ; 
  314.                            DriveNo : short_integer) ;
  315.      GEMDOS($47);
  316.       
  317.   function GetCurDrive : short_integer;  
  318.      GEMDOS($19);
  319.  
  320.   function Get_Resolution : short_integer ;
  321.      XBIOS( 4 ) ;
  322.  
  323.   procedure GetDrivePath ;
  324. {
  325. Get the default Path name and create default file names for four types of
  326. files associated with InfoBaseST.
  327.      .SCR  :  Screen Design file.
  328.      .DAT  :  Data Base file.
  329.      .PRT  :  Report Design file.
  330.      .TXT  :  Report Output to Disk file.
  331.      .HLP  :  Help File.
  332. }   
  333.     var
  334.        DriveNo   : short_integer ;
  335.        C_PathStr : C_String ;
  336.        P_PathStr : Str255 ;
  337.    
  338.      begin
  339.        DriveNo := GetCurDrive ;
  340.        GetCurPath(C_PathStr, 0) ;
  341.        C_To_PStr(C_PathStr, P_PathStr) ;
  342.        DefPathScr := Concat(chr(DriveNo + 65),':',P_PathStr, '\*.SCR') ;
  343.        DefPathDat := Concat(chr(DriveNo + 65),':',P_PathStr, '\*.DAT') ;
  344.        DefPathTxt := Concat(chr(DriveNo + 65),':',P_PathStr, '\*.TXT') ;
  345.        DefPathPrt := Concat(chr(DriveNo + 65),':',P_PathStr, '\*.PRT') ;
  346.        HelpFileName:=Concat(CHR(DriveNo + 65),':',P_PathStr, '\INFOBASE.HLP') ;
  347.      end ;
  348.  
  349.   procedure InitValues ;
  350. {
  351. Initialize variables.
  352. }
  353.      var
  354.         i : short_integer ;
  355.  
  356.       begin
  357.         DefFileScr := '' ;
  358.         DefFileDat := '' ;
  359.         DefFileTxt := '' ;
  360.         R_EditFlag := false ;
  361.         R_LoadFlag := false ;
  362.         ExitPrompt := false ;
  363.         ShortDraw  := false ;
  364.         SearchFlag := false ;
  365.         FullMemory := false ;
  366.         SortFlag   := false ;
  367.         OR_Search  := false ;
  368.         UpdateFlag := true ;
  369.  
  370.         XCur := 1 ;
  371.         YCur := 1 ;
  372.         Mode := 1 ;
  373.         P_Mode := 1 ;
  374.         RW_Offset := 0 ;
  375.         PL_Offset := 0 ;
  376.         LabLine := 5 ;
  377.         RepLine := 2 ;
  378.         RepWidth := 80 ;
  379.         LabSpace[1] := 0 ;
  380.         LabSpace[2] := 1 ;
  381.         DecReal := 5 ;
  382.         for i := 1 to 5 do
  383.             begin
  384.               PrtInit[i] := '' ;
  385.               PrtFlag[i] := false ;
  386.             end ;
  387.         Spacing := 12 * Resolution ;
  388.         TotScrRec := 0 ;
  389.         for i := 1 to MaxWind do
  390.             begin
  391.               RecNo[i] := 0 ;
  392.               TotalRec[i] := 0 ;
  393.               D_EditFlag[i] := false ;
  394.             end ;
  395.      end ;
  396.  
  397.   PROCEDURE CheckHelpFile(VAR Result : SHORT_INTEGER) ;
  398.  
  399.     TYPE
  400.        HelpLine = STRING[57] ;
  401.   
  402.     VAR
  403.        CheckFv : FILE OF HelpLine ;
  404.        SaveIO_Result : SHORT_INTEGER ;
  405.        AlertStr : STR255 ;
  406.        
  407.     LABEL 1 ;
  408.  
  409.      BEGIN
  410.        IO_Check(FALSE) ;
  411.        RESET(CheckFv,HelpFileName) ;
  412.        SaveIO_Result := IO_Result ;
  413. 1:     IF SaveIO_Result<>0 THEN
  414.           BEGIN
  415.             IF SaveIO_Result = -33 then
  416.                AlertStr := '[1][ Help File Not Found. | Must reside in same | directory as program | ]'
  417.             ELSE
  418.                BEGIN
  419.                  AlertStr := '[1][ Error with Help File Access |' ;
  420.                  AlertStr := Concat(AlertStr,'           ABORT?? | ]') ;
  421.                END ;
  422.             AlertStr := Concat(AlertStr, '[ ABORT | Continue ]') ;
  423.             Result := Do_Alert(AlertStr,1) ;
  424.           END 
  425.        ELSE
  426.           Result:=2 ;
  427.        CLOSE(CheckFv) ;
  428.        IO_Check(TRUE) ;
  429.      END ;
  430.  
  431. {
  432. MAIN PROGRAM
  433. }
  434.    BEGIN
  435.      if Init_Gem >= 0 then
  436.         begin
  437.           Resolution := Get_Resolution ;
  438.            if Resolution = 0 then
  439.              begin
  440.                 AlertStr := '[2][|This Program Will Not | ' ;
  441.                 AlertStr := Concat(AlertStr, '|  Operate in Low Res | ]') ;
  442.                 AlertStr := Concat(AlertStr, '[ Exit ]') ;
  443.                 Result   := Do_Alert(AlertStr,1) ;
  444.              end
  445.           else
  446.              begin
  447.                GetDrivePath ;
  448.                CheckHelpFile(Result) ;
  449.                IF Result <> 2 THEN GOTO 1 ;
  450.                GetMemBlocks ;
  451.                InitValues ;
  452.                SetUpMenu;
  453.                Init_Mouse ;
  454.                CopyRight ;
  455.                DrawNewWindow ;
  456.                Event_Loop ;
  457.                NewCursor(ScrNum) ;
  458.                Set_VSlideSize ;
  459.  
  460.                repeat
  461.                   Event_Loop ;
  462.                Until ExitPrompt;
  463. 1 :          end;
  464.         end;
  465.      Exit_Gem;
  466.    END.
  467.  
  468.